Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/gridex/frmorder.frm

Visual Basic Form | 1998-01-02 | 33.1 KB | 974 lines

VERSION 5.00
Object = "{BA7155BB-813E-11D1-B8F4-0080ADA85B53}#1.0#0"; "JSGridEX.ocx"
Begin VB.Form frmOrders
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Orders"
   ClientHeight    =   5460
   ClientLeft      =   525
   ClientTop       =   1965
   ClientWidth     =   8040
   BeginProperty Font
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmOrders.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5460
   ScaleWidth      =   8040
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   360
      Left            =   3015
      TabIndex        =   8
      Top             =   5040
      Width           =   1200
   End
   Begin VB.CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   360
      Left            =   4335
      TabIndex        =   9
      Top             =   5040
      Width           =   1200
   End
   Begin VB.ComboBox cboShippers
      Height          =   315
      Left            =   5310
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   1920
      Width           =   2655
   End
   Begin VB.ComboBox cboEmployee
      Height          =   315
      Left            =   1200
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   1920
      Width           =   2805
   End
   Begin VB.PictureBox Picture2
      Height          =   1395
      Index           =   0
      Left            =   4065
      ScaleHeight     =   89
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   256
      TabIndex        =   28
      Top             =   465
      Width           =   3900
      Begin VB.TextBox txtShip
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   3
         Left            =   1785
         TabIndex        =   34
         Top             =   765
         Width           =   975
      End
      Begin VB.TextBox txtShip
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   2
         Left            =   765
         TabIndex        =   33
         Top             =   765
         Width           =   975
      End
      Begin VB.TextBox txtShip
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   5
         Left            =   1635
         TabIndex        =   32
         Top             =   1050
         Width           =   2130
      End
      Begin VB.TextBox txtShip
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   4
         Left            =   2790
         TabIndex        =   31
         Top             =   765
         Width           =   975
      End
      Begin VB.TextBox txtShip
         BorderStyle     =   0  'None
         Height          =   405
         Index           =   1
         Left            =   765
         MultiLine       =   -1  'True
         TabIndex        =   30
         Top             =   315
         Width           =   3000
      End
      Begin VB.TextBox txtShip
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   0
         Left            =   765
         TabIndex        =   29
         Top             =   30
         Width           =   3000
      End
      Begin VB.Label Label2
         AutoSize        =   -1  'True
         Caption         =   "Ship To:"
         BeginProperty Font
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   195
         Index           =   5
         Left            =   60
         TabIndex        =   35
         Top             =   30
         Width           =   660
      End
   End
   Begin VB.PictureBox Picture2
      Height          =   1785
      Index           =   1
      Left            =   105
      ScaleHeight     =   115
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   256
      TabIndex        =   20
      Top             =   75
      Width           =   3900
      Begin VB.CommandButton cmdCustomerID
         Caption         =   "..."
         Height          =   255
         Left            =   1905
         TabIndex        =   36
         TabStop         =   0   'False
         Top             =   90
         Width           =   345
      End
      Begin VB.TextBox txtCustomerID
         Height          =   315
         Left            =   765
         TabIndex        =   1
         Top             =   60
         Width           =   1515
      End
      Begin VB.TextBox txtCustInfo
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   0
         Left            =   780
         Locked          =   -1  'True
         TabIndex        =   27
         Top             =   420
         Width           =   3000
      End
      Begin VB.TextBox txtCustInfo
         BorderStyle     =   0  'None
         Height          =   405
         Index           =   1
         Left            =   780
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         TabIndex        =   26
         Top             =   705
         Width           =   3000
      End
      Begin VB.TextBox txtCustInfo
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   4
         Left            =   2805
         Locked          =   -1  'True
         TabIndex        =   25
         Top             =   1155
         Width           =   975
      End
      Begin VB.TextBox txtCustInfo
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   5
         Left            =   1650
         Locked          =   -1  'True
         TabIndex        =   24
         Top             =   1440
         Width           =   2130
      End
      Begin VB.TextBox txtCustInfo
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   2
         Left            =   780
         Locked          =   -1  'True
         TabIndex        =   22
         Top             =   1155
         Width           =   975
      End
      Begin VB.TextBox txtCustInfo
         BorderStyle     =   0  'None
         Height          =   240
         Index           =   3
         Left            =   1800
         Locked          =   -1  'True
         TabIndex        =   21
         Top             =   1155
         Width           =   975
      End
      Begin VB.Label Label2
         AutoSize        =   -1  'True
         Caption         =   "Bill To:"
         BeginProperty Font
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   195
         Index           =   6
         Left            =   75
         TabIndex        =   23
         Top             =   90
         Width           =   540
      End
   End
   Begin VB.TextBox txtDate
      Height          =   315
      Index           =   8
      Left            =   6660
      TabIndex        =   6
      Top             =   2250
      Width           =   1305
   End
   Begin VB.TextBox txtDate
      Height          =   315
      Index           =   7
      Left            =   3960
      TabIndex        =   5
      Top             =   2250
      Width           =   1200
   End
   Begin VB.TextBox txtDate
      Height          =   315
      Index           =   6
      Left            =   1215
      TabIndex        =   4
      Top             =   2250
      Width           =   1200
   End
   Begin VB.PictureBox Picture1
      Height          =   945
      Left            =   5640
      ScaleHeight     =   885
      ScaleWidth      =   2310
      TabIndex        =   11
      Top             =   4470
      Width           =   2370
      Begin VB.TextBox txtFreight
         BorderStyle     =   0  'None
         Height          =   240
         Left            =   990
         TabIndex        =   40
         Top             =   330
         Visible         =   0   'False
         Width           =   1290
      End
      Begin VB.Label lblFreight
         Alignment       =   1  'Right Justify
         BackColor       =   &H80000005&
         ForeColor       =   &H80000007&
         Height          =   240
         Left            =   990
         TabIndex        =   39
         Top             =   330
         Width           =   1290
      End
      Begin VB.Label lblTotal
         Alignment       =   1  'Right Justify
         BackColor       =   &H80000005&
         ForeColor       =   &H80000007&
         Height          =   240
         Left            =   990
         TabIndex        =   38
         Top             =   600
         Width           =   1290
      End
      Begin VB.Label lblSubTotal
         Alignment       =   1  'Right Justify
         BackColor       =   &H80000005&
         ForeColor       =   &H80000007&
         Height          =   240
         Left            =   990
         TabIndex        =   37
         Top             =   60
         Width           =   1290
      End
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         Caption         =   "Total:"
         BeginProperty Font
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   195
         Index           =   3
         Left            =   135
         TabIndex        =   14
         Top             =   615
         Width           =   480
      End
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         Caption         =   "Freight:"
         BeginProperty Font
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   195
         Index           =   2
         Left            =   135
         TabIndex        =   13
         Top             =   345
         Width           =   645
      End
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         Caption         =   "SubTotal:"
         BeginProperty Font
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   195
         Index           =   1
         Left            =   135
         TabIndex        =   12
         Top             =   75
         Width           =   795
      End
   End
   Begin JSGridEX.GridEX gexDetails
      Height          =   1695
      Left            =   90
      TabIndex        =   7
      Top             =   2655
      Width           =   7905
      _ExtentX        =   13944
      _ExtentY        =   2990
      MethodHoldFields=   -1  'True
      SelectionStyle  =   1
      DatabaseName    =   "C:\Advanced Sample\Nwind.mdb"
      AutomaticArrange=   0   'False
      AllowDelete     =   -1  'True
      GroupByBoxVisible=   0   'False
      NewRowPos       =   1
      RowHeaders      =   -1  'True
      ColumnCount     =   7
      ColCaption1     =   "OrderID"
      ColDataField1   =   "OrderID"
      ColKey1         =   "OrderID"
      ColVisible1     =   0   'False
      ColSortType1    =   2
      ColTextAlignment2=   2
      ColCaption2     =   "Product ID"
      ColDataField2   =   "ProductID"
      ColKey2         =   "ProductID"
      ColWidth2       =   1095
      ColSortType2    =   2
      ColFormat3      =   "Currency"
      ColTextAlignment3=   2
      ColCaption3     =   "Unit Price"
      ColDataField3   =   "UnitPrice"
      ColKey3         =   "UnitPrice"
      ColPosition3    =   4
      ColWidth3       =   900
      ColSortType3    =   2
      ColTextAlignment4=   2
      ColCaption4     =   "Quantity"
      ColDataField4   =   "Quantity"
      ColKey4         =   "Quantity"
      ColPosition4    =   5
      ColWidth4       =   810
      ColSortType4    =   2
      ColTextAlignment5=   2
      ColCaption5     =   "Discount"
      ColDataField5   =   "Discount"
      ColKey5         =   "Discount"
      ColPosition5    =   6
      ColWidth5       =   840
      ColSortType5    =   2
      ColCaption6     =   "Product"
      ColDataField6   =   "ProductName"
      ColKey6         =   "ProductName"
      ColPosition6    =   3
      ColWidth6       =   2400
      ColEditType6    =   0
      ColFormat7      =   "Currency"
      ColTextAlignment7=   2
      ColCaption7     =   "Price"
      ColDataField7   =   "Price"
      ColKey7         =   "Price"
      ColWidth7       =   1200
      ColEditType7    =   0
      HeaderFontBold  =   -1  'True
      HeaderFontWeight=   700
      AllowAddNew     =   -1  'True
      ColumnHeaderHeight=   285
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   "Ship Via:"
      Height          =   195
      Index           =   4
      Left            =   4530
      TabIndex        =   19
      Top             =   1965
      Width           =   615
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   "Salesperson:"
      Height          =   195
      Index           =   3
      Left            =   120
      TabIndex        =   18
      Top             =   1995
      Width           =   930
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   "Shipped Date:"
      Height          =   195
      Index           =   2
      Left            =   5385
      TabIndex        =   17
      Top             =   2310
      Width           =   1020
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   "Required Date:"
      Height          =   195
      Index           =   1
      Left            =   2640
      TabIndex        =   16
      Top             =   2310
      Width           =   1095
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   "Order Date:"
      Height          =   195
      Index           =   0
      Left            =   120
      TabIndex        =   15
      Top             =   2310
      Width           =   870
   End
   Begin VB.Label lblOrderNo
      BackStyle       =   0  'Transparent
      Caption         =   " N/A"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   7350
      TabIndex        =   10
      Top             =   90
      Width           =   600
   End
   Begin VB.Label Label1
      BackStyle       =   0  'Transparent
      Caption         =   "ORDER #"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   0
      Left            =   6420
      TabIndex        =   0
      Top             =   120
      Width           =   750
   End
   Begin VB.Image Image1
      Height          =   240
      Index           =   3
      Left            =   6075
      Picture         =   "frmOrders.frx":014A
      Stretch         =   -1  'True
      Top             =   90
      Width           =   240
   End
   Begin VB.Shape Shape1
      BackStyle       =   1  'Opaque
      Height          =   375
      Left            =   5985
      Top             =   30
      Width           =   1995
   End
Attribute VB_Name = "frmOrders"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m_db As Database
Dim mrstOrders As Recordset
Dim mrstCustomers As Recordset
Dim mrstProducts As Recordset
Dim mbIsNew As Boolean
Dim mvarBookmark As Variant
Const fldShipTo = 0
Const fldShipAddress = 1
Const fldShipCity = 2
Const fldShipRegion = 3
Const fldShipPostalCode = 4
Const fldShipCountry = 5
Const fldOrderDate = 6
Const fldRequiredDate = 7
Const fldShippedDate = 8
Const fldEmployeeID = 9
Const fldShipVia = 10
Const fldFreight = 11
Const fldCustomerID = 12
Const fldCustName = 0
Const fldCustAddress = 1
Const fldCustCity = 2
Const fldCustRegion = 3
Const fldCustPostalCode = 4
Const fldCustCountry = 5
Dim m_DataChanged(0 To 12) As Boolean
Public Key As String
Public Sub SeeOrder(rst As Recordset)
Dim rstTemp As Recordset
Dim dbtemp As Database
On Error Resume Next
    Caption = "Orders - " & rst![OrderID]
    lblOrderNo = rst![OrderID]
    txtShip(0) = rst![ShipName]
    txtShip(1) = rst![ShipAddress]
    txtShip(2) = rst![ShipCity]
    txtShip(3) = rst![ShipRegion]
    txtShip(4) = rst![ShipPostalCode]
    txtShip(5) = rst![ShipCountry]
    Set dbtemp = OpenDatabase(gexDetails.DatabaseName)
    Set rstTemp = dbtemp.OpenRecordset("Employees", dbOpenTable)
    rstTemp.Index = "PrimaryKey"
    rstTemp.Seek "=", rst![EmployeeID]
    rstTemp.Close
    Set rstTemp = dbtemp.OpenRecordset("Shippers", dbOpenTable)
    rstTemp.Index = "PrimaryKey"
    rstTemp.Seek "=", rst![ShipVia]
    rstTemp.Close
    Set rstTemp = dbtemp.OpenRecordset("Customers", dbOpenTable)
    rstTemp.Index = "PrimaryKey"
    rstTemp.Seek "=", rst![CustomerID]
    If Not rstTemp.NoMatch Then
        txtShip(11) = rstTemp![CompanyName]
        txtShip(10) = rstTemp![Address]
        txtShip(9) = rstTemp![City]
        txtShip(8) = rstTemp![Region]
        txtShip(7) = rstTemp![PostalCode]
        txtShip(6) = rstTemp![Country]
    End If
    gexDetails.RecordSource = "SELECT [Order Details].*, Products.ProductName, ([Order Details]![UnitPrice]*[Order Details]![Quantity])*(1-[Order Details]![Discount]) AS Price FROM Products INNER JOIN [Order Details] ON Products.ProductID = [Order Details].ProductID WHERE [Order Details].OrderID=" & rst![OrderID]
    gexDetails.HoldFields
    gexDetails.Rebind
    CalculateTotals rst![Freight]
    Show
End Sub
Private Sub CalculateTotals(Freight As Currency)
Dim rst As Recordset
Dim amount As Currency
    Set rst = gexDetails.Recordset
    On Error Resume Next
    rst.MoveFirst
    Do Until rst.EOF
        amount = amount + rst![Price]
        rst.MoveNext
    Loop
    lblSubTotal = Format(amount, "Currency")
    lblFreight = Format(Freight, "Currency")
    lblTotal = Format(amount + Freight, "Currency")
End Sub
Private Sub cboEmployee_Click()
    m_DataChanged(fldEmployeeID) = True
End Sub
Private Sub cboEmployee_Change()
    m_DataChanged(fldEmployeeID) = True
End Sub
Private Sub cboShippers_Click()
    m_DataChanged(fldShipVia) = True
End Sub
Private Sub cboShippers_Change()
    m_DataChanged(fldShipVia) = True
End Sub
Private Sub cmdCancel_Click()
    If mbIsNew And Not IsNull(mvarBookmark) Then
        mrstOrders.Delete
    End If
    Unload Me
End Sub
Private Sub cmdCustomerID_Click()
Dim varCustID As Variant
    varCustID = frmList.ChooseCustomer(m_db.Name, txtCustomerID)
    If Not IsNull(varCustID) Then
        txtCustomerID = varCustID
        txtCustomerID.SelStart = 0
        txtCustomerID.SelLength = Len(txtCustomerID)

    End If
    txtCustomerID.SetFocus
End Sub
Private Sub cmdOK_Click()
On Error GoTo EH_cmdOK
    If ActiveControl Is txtFreight Then
        txtFreight_LostFocus
    ElseIf ActiveControl Is gexDetails Then
        gexDetails.Update
    End If
    If Not SaveOrder Then Exit Sub
    If mbIsNew Then
        frmMain.OnRecordUpdate CatalogOrders, Null
    Else
        frmMain.OnRecordUpdate CatalogOrders, mvarBookmark
    End If
    Unload Me
    Exit Sub
EH_cmdOK:
    MsgBox Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
    frmMain.UnloadForm Key
End Sub
Private Sub gexDetails_AfterColUpdate(ByVal ColIndex As Integer)
On Error Resume Next
Dim curUnitPrice As Currency
Dim sngQuantity As Single
Dim sngDiscount As Single
Dim colQuantity As Column
    Set colQuantity = gexDetails.Columns("Quantity")
    If Not colQuantity.DataChanged Then
        gexDetails.Value(colQuantity.Index) = 1
    End If
    Select Case ColIndex
        Case 2
            mrstProducts.Index = "PrimaryKey"
            mrstProducts.Seek "=", gexDetails.Value(2)
            If mrstProducts.NoMatch Then
                gexDetails.Value(6) = ""
            Else
                gexDetails.Value(6) = mrstProducts![ProductName]
                gexDetails.Value(3) = mrstProducts![UnitPrice]
                gexDetails_AfterColUpdate 3
            End If
        Case 3, 4, 5
            curUnitPrice = CCur(gexDetails.Value(3))
            sngQuantity = CSng(gexDetails.Value(4))
            sngDiscount = CSng(gexDetails.Value(5))
            gexDetails.Value(7) = curUnitPrice * sngQuantity * (1 - sngDiscount)
    End Select
End Sub
Private Sub gexDetails_AfterDelete()
    gexDetails_AfterUpdate
End Sub
Private Sub gexDetails_AfterUpdate()
    If lblFreight.Caption = "" Then
        CalculateTotals 0
    Else
        CalculateTotals CCur(lblFreight.Caption)
    End If
End Sub
Private Sub gexDetails_BeforeUpdate(Cancel As Boolean)
    If IsNull(mvarBookmark) Then
        If Len(txtCustomerID.Text) = 0 Then
            MsgBox "Select a customer to bill to before entering order details info.", vbInformation
            gexDetails.DataChanged = False
            txtCustomerID.SetFocus
            Cancel = True
            Exit Sub
        Else
            If Not SaveOrder Then
                Cancel = True
            End If
        End If
    End If
    If gexDetails.Value(1) = "" Then
        gexDetails.Value(1) = mrstOrders![OrderID]
    End If
    gexDetails.Columns(6).DataChanged = False
    gexDetails.Columns(7).DataChanged = False
End Sub
Private Sub gexDetails_ColumnHeaderClick(Column As JSGridEX.Column)
    gexDetails.SortKeys.Clear
    gexDetails.SortKeys.Add Column.Index, jgexSortAscending
End Sub
Private Sub lblFreight_Click()
    txtFreight.Text = lblFreight.Caption
    txtFreight.SelStart = 0
    txtFreight.SelLength = Len(txtFreight)
    txtFreight.Visible = True
    txtFreight.SetFocus
End Sub
Private Sub txtCustomerID_Change()
    SearchCustomer
    m_DataChanged(fldCustomerID) = True
End Sub
Private Sub SearchCustomer()
On Error Resume Next
Dim i As Integer
    mrstCustomers.Index = "PrimaryKey"
    mrstCustomers.Seek "=", txtCustomerID
    If mrstCustomers.NoMatch Then
        For i = fldCustName To fldCustCountry
            txtCustInfo(i).Text = ""
        Next
    Else
        txtCustInfo(fldCustName) = mrstCustomers![CompanyName]
        txtCustInfo(fldCustAddress) = mrstCustomers![Address]
        txtCustInfo(fldCustCity) = mrstCustomers![City]
        txtCustInfo(fldCustRegion) = mrstCustomers![Region]
        txtCustInfo(fldCustPostalCode) = mrstCustomers![PostalCode]
        txtCustInfo(fldCustCountry) = mrstCustomers![Country]
        If Not m_DataChanged(fldShipTo) Then txtShip(fldShipTo).Text = mrstCustomers![ContactName]
        If Not m_DataChanged(fldShipAddress) Then txtShip(fldShipAddress).Text = mrstCustomers![Address]
        If Not m_DataChanged(fldShipCity) Then txtShip(fldShipCity).Text = mrstCustomers![City]
        If Not m_DataChanged(fldShipRegion) Then txtShip(fldShipRegion).Text = mrstCustomers![Region]
        If Not m_DataChanged(fldShipPostalCode) Then txtShip(fldShipPostalCode).Text = mrstCustomers![PostalCode]
        If Not m_DataChanged(fldShipCountry) Then txtShip(fldShipCountry).Text = mrstCustomers![Country]
    End If
End Sub
Public Sub EditRecord(db As Database, rs As Recordset)
Dim i As Long
Dim lngID As Long
On Error Resume Next
    Set m_db = db
    Set mrstCustomers = m_db.OpenRecordset("Customers", dbOpenTable)
    Set mrstProducts = m_db.OpenRecordset("Products", dbOpenTable)
    Set mrstOrders = rs.Clone
    mvarBookmark = rs.Bookmark
    mrstOrders.Bookmark = mvarBookmark
    FillEmployeeList
    FillShippersList
    txtCustomerID.Text = mrstOrders![CustomerID]
    txtShip(fldShipTo).Text = mrstOrders![ShipName]
    txtShip(fldShipAddress).Text = mrstOrders![ShipAddress]
    txtShip(fldShipCity).Text = mrstOrders![ShipCity]
    txtShip(fldShipRegion).Text = mrstOrders![ShipRegion]
    txtShip(fldShipPostalCode).Text = mrstOrders![ShipPostalCode]
    txtShip(fldShipCountry).Text = mrstOrders![ShipCountry]
    txtDate(fldOrderDate) = Format(mrstOrders![OrderDate], "Medium Date")
    txtDate(fldRequiredDate) = Format(mrstOrders![RequiredDate], "Medium Date")
    txtDate(fldShippedDate) = Format(mrstOrders![ShippedDate], "Medium Date")
    If Not IsNull(mrstOrders![EmployeeID]) Then
        lngID = mrstOrders![EmployeeID]
    End If
    For i = 0 To cboEmployee.ListCount - 1
        If cboEmployee.ItemData(i) = lngID Then
            cboEmployee.ListIndex = i
            Exit For
        End If
    Next
    If Not IsNull(mrstOrders![ShipVia]) Then
        lngID = mrstOrders![ShipVia]
    Else
        lngID = 0
    End If
    For i = 0 To cboShippers.ListCount - 1
        If cboShippers.ItemData(i) = lngID Then
            cboShippers.ListIndex = i
            Exit For
        End If
    Next
    lblOrderNo.Caption = mrstOrders![OrderID]
    Caption = "Orders - Order # " & mrstOrders![OrderID]
    For i = 0 To UBound(m_DataChanged)
        m_DataChanged(i) = False
    Next
    gexDetails.DatabaseName = m_db.Name
    gexDetails.RecordSource = "SELECT [Order Details].*, Products.ProductName, ([Order Details]![UnitPrice]*[Order Details]![Quantity])*(1-[Order Details]![Discount]) AS Price FROM Products INNER JOIN [Order Details] ON Products.ProductID = [Order Details].ProductID WHERE [Order Details].OrderID=" & mrstOrders![OrderID]
    gexDetails.HoldFields
    gexDetails.Rebind
    If IsNull(mrstOrders![Freight]) Then
        Call CalculateTotals(0)
    Else
        Call CalculateTotals(mrstOrders![Freight])
    End If
    Me.Show
End Sub
Public Sub NewRecord(db As Database, rs As Recordset)
Dim i As Long
Dim lngID As Long
On Error Resume Next
    Set m_db = db
    Set mrstCustomers = m_db.OpenRecordset("Customers", dbOpenTable)
    Set mrstProducts = m_db.OpenRecordset("Products", dbOpenTable)
    Set mrstOrders = rs.Clone
    mbIsNew = True
    mvarBookmark = Null
    FillEmployeeList
    FillShippersList
    txtDate(fldOrderDate) = Format(Date, "Medium Date")
    txtDate(fldShippedDate) = Format(Date, "Medium Date")
    txtDate(fldRequiredDate) = Format(Date, "Medium Date")
    Caption = "Orders - New Order"
    For i = 0 To UBound(m_DataChanged)
        m_DataChanged(i) = False
    Next
    gexDetails.DatabaseName = m_db.Name
    gexDetails.RecordSource = "SELECT [Order Details].*, Products.ProductName, ([Order Details]![UnitPrice]*[Order Details]![Quantity])*(1-[Order Details]![Discount]) AS Price FROM Products INNER JOIN [Order Details] ON Products.ProductID = [Order Details].ProductID WHERE [Order Details].OrderID=0"
    gexDetails.HoldFields
    gexDetails.Rebind
    Call CalculateTotals(0)
    Me.Show
End Sub
Private Sub FillEmployeeList()
Dim rsTemp As Recordset
    Set rsTemp = m_db.OpenRecordset("SELECT Employees.EmployeeID, Employees.FirstName & ' ' & Employees.LastName AS Name From Employees", dbOpenSnapshot)
    cboEmployee.Clear
    cboEmployee.AddItem ""
    Do Until rsTemp.EOF
        cboEmployee.AddItem rsTemp![Name]
        cboEmployee.ItemData(cboEmployee.NewIndex) = rsTemp![EmployeeID]
        rsTemp.MoveNext
    Loop
End Sub
Private Sub FillShippersList()
Dim rsTemp As Recordset
    Set rsTemp = m_db.OpenRecordset("SELECT * From Shippers", dbOpenSnapshot)
    cboShippers.Clear
    cboShippers.AddItem ""
    Do Until rsTemp.EOF
        cboShippers.AddItem rsTemp![CompanyName]
        cboShippers.ItemData(cboShippers.NewIndex) = rsTemp![ShipperID]
        rsTemp.MoveNext
    Loop
End Sub
Private Sub txtDate_Change(Index As Integer)
    m_DataChanged(Index) = True
End Sub
Private Sub txtFreight_Change()
    m_DataChanged(fldFreight) = True
End Sub
Private Sub txtFreight_LostFocus()
Dim cTemp As Currency
On Error Resume Next
    cTemp = CCur(txtFreight)
    If Err = 0 Then
        CalculateTotals (cTemp)
    End If
    txtFreight.Visible = False
End Sub
Private Sub txtShip_Change(Index As Integer)
    m_DataChanged(Index) = True
End Sub
Private Function SaveOrder() As Boolean
On Error GoTo EH_SaveOrder
Dim curTemp As Currency
    If IsDirty Then
        If IsNull(mvarBookmark) Then
            mrstOrders.AddNew
        Else
            mrstOrders.Bookmark = mvarBookmark
            mrstOrders.Edit
        End If
        If m_DataChanged(fldCustomerID) Then mrstOrders![CustomerID] = txtCustomerID
        If m_DataChanged(fldShipTo) Then mrstOrders![ShipName] = txtShip(fldShipTo)
        If m_DataChanged(fldShipAddress) Then mrstOrders![ShipAddress] = txtShip(fldShipAddress)
        If m_DataChanged(fldShipRegion) Then mrstOrders![ShipRegion] = txtShip(fldShipRegion)
        If m_DataChanged(fldShipCity) Then mrstOrders![ShipCity] = txtShip(fldShipCity)
        If m_DataChanged(fldShipPostalCode) Then mrstOrders![ShipPostalCode] = txtShip(fldShipPostalCode)
        If m_DataChanged(fldShipCountry) Then mrstOrders![ShipCountry] = txtShip(fldShipCountry)
        If m_DataChanged(fldOrderDate) Then mrstOrders![OrderDate] = TextToNull(txtDate(fldOrderDate))
        If m_DataChanged(fldRequiredDate) Then mrstOrders![RequiredDate] = TextToNull(txtDate(fldRequiredDate))
        If m_DataChanged(fldShippedDate) Then mrstOrders![ShippedDate] = TextToNull(txtDate(fldShippedDate))
        If m_DataChanged(fldFreight) Then
            On Error Resume Next
            curTemp = CCur(lblFreight)
            On Error GoTo EH_SaveOrder
            mrstOrders![Freight] = curTemp
        End If
        If m_DataChanged(fldEmployeeID) Then
            If cboEmployee.Text = "" Then
                mrstOrders![EmployeeID] = Null
            Else
                mrstOrders![EmployeeID] = cboEmployee.ItemData(cboEmployee.ListIndex)
            End If
        End If
        If m_DataChanged(fldShipVia) Then
            If cboShippers.Text = "" Then
                mrstOrders![ShipVia] = Null
            Else
                mrstOrders![ShipVia] = cboShippers.ItemData(cboShippers.ListIndex)
            End If
        End If
        Dim vTemp As Variant
        mrstOrders.Update
        If IsNull(mvarBookmark) Then
            mvarBookmark = mrstOrders.LastModified
            mrstOrders.Bookmark = mvarBookmark
        End If

        lblOrderNo.Caption = mrstOrders![OrderID]
        Caption = "Orders - Order # " & mrstOrders![OrderID]
    End If
    SaveOrder = True
    Exit Function
EH_SaveOrder:
    MsgBox Err.Description, vbExclamation
End Function
Private Function IsDirty() As Boolean
Dim i As Integer
    For i = 0 To UBound(m_DataChanged)
        If m_DataChanged(i) Then
            IsDirty = True
            Exit Function
        End If
    Next
End Function